home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / p063b9s.zip / UTIL / AREA2POP.PAS < prev    next >
Pascal/Delphi Source File  |  1994-05-08  |  4KB  |  156 lines
  1. PROGRAM Area2PoP;
  2. {╔══════════════════════════════════════════════════════════════════════════╗}
  3. {║ Converts AREAS.BBS to PORTAL.ARE              Last changed: 08.04.94  JS ║}
  4. {║                                                                          ║}
  5. {║                         (C) Copyright 1989-93 by                         ║}
  6. {║       Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager        ║}
  7. {║                                                                          ║}
  8. {║ This source can be distributed freely, as long as it is done in a        ║}
  9. {║ lawfull and friendly manner.                                             ║}
  10. {╚══════════════════════════════════════════════════════════════════════════╝}
  11.  
  12. USES Dos, OpString, PopTypes;
  13.  
  14. VAR
  15.   BasePath : PathStr;
  16.   Update   : BOOLEAN;
  17.  
  18. PROCEDURE Convert;
  19. VAR
  20.   AreasBbs : Text;
  21.   AreasDat : File Of TMsgArea;
  22.   AreasRec : TMsgArea;
  23.   Tmp,InStr    : String;
  24.   x : Byte;
  25.   Ok : Integer;
  26.  
  27.   PROCEDURE FindArea;
  28.   VAR
  29.     Ar:TMsgArea;
  30.     curpos:LONGINT;
  31.     Found:BOOLEAN;
  32.   BEGIN
  33.     curpos:=FILEPOS(AreasDat);
  34.     SEEK(AreasDat,0);
  35.     Found:=FALSE;
  36.     WHILE NOT EOF(AreasDat) AND NOT Found DO
  37.     BEGIN
  38.       READ(AreasDat,ar);
  39.       IF Ar.EchoNames[1]=AreasRec.EchoNames[1] THEN
  40.       BEGIN
  41.         Found:=TRUE;
  42.         curpos:=FILEPOS(AreasDat)-1;
  43.         Ar.Directory:=AreasRec.Directory;
  44.         Ar.SendTo[1]:=AreasRec.SendTo[1];
  45.         Ar.SendTo[2]:=AreasRec.SendTo[2];
  46.         AreasRec:=Ar;
  47.       END;
  48.     END;
  49.     IF NOT Found THEN curpos:=FILESIZE(AreasDat);
  50.     SEEK(AreasDat,curpos);
  51.   END;
  52.  
  53. BEGIN
  54.   WriteLn;
  55.   WriteLn('Areas.bbs To Portal of Power converter v'+Ver);
  56.   WriteLn('(c) Copyright 1992 by The Portal Team');
  57.   WriteLn;
  58.   Assign(AreasBbs, 'AREAS.BBS');
  59.   Reset(AreasBbs);
  60.   IF IOResult<>0 THEN Halt(1);
  61.   Assign(AreasDat, 'PORTAL.ARE');
  62.   Reset(AreasDat);
  63.   IF IOResult<>0 THEN
  64.   BEGIN
  65.     ReWrite(AreasDat);
  66.     Update:=FALSE;
  67.   END;
  68.   ReadLn(AreasBbs, InStr);
  69.   WriteLn('Converting:');
  70.   WHILE Not Eof(AreasBbs) DO
  71.   BEGIN
  72.     ReadLn(AreasBbs, InStr);
  73.     IF (Length(INstr)>0) and not (InStr[1] IN [';','-']) THEN
  74.     BEGIN
  75.       FillChar(AreasRec, SizeOf(AreasRec), 0);
  76.       WITH AreasRec DO
  77.       BEGIN
  78.         IF (InStr[1]<>'#') And (StUpCase(Copy(InStr,1,2))<>'P ') THEN
  79.         BEGIN
  80.           Tmp:=Copy(InStr,1,Pos(' ',InStr)-1);
  81.           Val(Tmp,x,ok);
  82.           IF Ok=0 THEN
  83.             Directory:=BasePath+Tmp
  84.           ELSE
  85.           BEGIN
  86.             If copy(tmp,1,1)='$' then
  87.             BEGIN
  88.               Directory:=copy(tmp,2,255);
  89.               AreaType:=2;
  90.             END
  91.             ELSE
  92.               Directory:=AddBackSlash(Tmp);
  93.           END;
  94.         END;
  95.         InStr:=Copy(InStr,Pos(' ',InStr),255);
  96.         InStr:=TrimLead(InStr);
  97.         EchoNames[1]:=StUpCase(Copy(InStr,1,Pos(' ',InStr)-1));
  98.         InStr:=Copy(InStr,Pos(' ',InStr),255);
  99.         InStr:=TrimLead(InStr);
  100.         SendTo[1]:=InStr;
  101.         Write(EchoNames[1],' ':10,#13);
  102.       END;
  103.       IF AreasRec.EchoNames[1]<>'' THEN
  104.       BEGIN
  105.         IF Update THEN FindArea;
  106.         Write(AreasDat,AreasRec);
  107.       END;
  108.     END;
  109.   END;
  110.   writeln;
  111.   Close(AreasDat);
  112.   Close(AreasBbs);
  113. END;
  114.  
  115. PROCEDURE ShowHelp;
  116. BEGIN
  117.   WRITELN;
  118.   WRITELN('Available switches:');
  119.   WRITELN;
  120.   WRITELN('/B[path]   Specifies an alternate path for message bases of Hudson format');
  121.   WRITELN('/U         Update existing, and add non-existing areas');
  122.   WRITELN;
  123.   HALT;
  124. END;
  125.  
  126. PROCEDURE ParseCmdLine;
  127. VAR
  128.   i:BYTE;
  129.   s:STRING;
  130. BEGIN
  131.   BasePath:='';
  132.   Update:=FALSE;
  133.   FOR i:=1 TO ParamCount DO
  134.   BEGIN
  135.     s:=StUpCase(ParamStr(i));
  136.     IF s[1] IN ['-','/'] THEN
  137.     BEGIN
  138.       CASE s[2] OF
  139.         'B'  : BasePath:=AddBackSlash(COPY(s,3,255));
  140.         '?'  : ShowHelp;
  141.         'U'  : Update:=TRUE;
  142.         ELSE
  143.         BEGIN
  144.           WRITELN('Invalid parameter "'+s[2]+'"');
  145.           HALT(2);
  146.         END;
  147.       END;
  148.     END;
  149.   END;
  150. END;
  151.  
  152. BEGIN
  153.   ParseCmdLine;
  154.   Convert;
  155. END.
  156.